//	COPYRIGHT (C) 1981 BY BOARD OF TRUSTEES,
//	LELAND STANFORD JUNIOR UNIVERSITY

STATIC $( THISPARTSTR = "GENOA"; QQSTR ="GENOA-HELP" $);
STATIC $( MOLFORM = NIL; STRUCSTATUS = NIL; ALLDEFS = NIL; MODMF = NIL;
          CONLENGTHS = NIL; PREVCONS = NIL; ALTERNATES = NIL; ALTS = NIL;
          MINSTRUCNO = NIL; MAXSTRUCNO = NIL; STEREOSTRUCS = NIL;
          TERMTYPE = NIL $);

/* EXTRA STATICS TO ALLOW FOR SCORES ASSOCIATED WITH "ALTERNATIVES". */
MANIFEST $( CFMAX = 1000 $)
STATIC $( BELIEF = NIL; DISBELIEF = NIL; SCORE = NIL $);

STATIC $( INPUTSAVE = NIL; OUTPUTSAVE = NIL $);
/* EXTRA STATICS FOR COMPATIBILITY WITH JGN CHANGES IN ESSHDR. */
STATIC $( SWADTYPE = FALSE; SWASTNUM = 0 $)

LET OPENIN(FILEFN) BE
 $(
 INPUTSAVE:=INPUT;
 SWAPLITEMS();
 INPUT:=FINDFILE("DSK",FILEFN(),CGEXT);
 $);

LET CLOSEIN() BE
 $(
 ENDREAD(INPUT);
 INPUT:=INPUTSAVE;
 SWAPLITEMS()
 $);

LET OPENOUT(FILEFN) BE
 $(
 OUTPUTSAVE:=OUTPUT;
 OUTPUT:=CREATEFILE("DSK",FILEFN(),CGEXT)
 $);

LET CLOSEOUT() BE
 $(
 ENDWRITE(OUTPUT);
 OUTPUT:=OUTPUTSAVE
 $);

LET GLIINIT() BE
 $(
 INPUTSAVE:=INPUT;
 INPUT:=FINDFILE("DSK","INIT","GLI",MAKPPN);
 OPENOUT(TOPFILENAME);
 COPYTOEND();
 CLOSEIN();
 CLOSEOUT();
 LPOSN:=0;

 WHILE FILEEXISTS(STRFILENAME(),CGEXT) DO
  DELETEFILE(STRFILENAME(),CGEXT);
 WHILE FILEEXISTS(STIFILENAME(),CGEXT) DO
  DELETEFILE(STIFILENAME(),CGEXT);
 WHILE FILEEXISTS(MSFFILENAME(),CGEXT) DO
  DELETEFILE(MSFFILENAME(),CGEXT);
 WHILE FILEEXISTS(NMRFILENAME(),CGEXT) DO
  DELETEFILE(NMRFILENAME(),CGEXT);
 WHILE FILEEXISTS(MSPFILENAME(),CGEXT) DO
  DELETEFILE(MSPFILENAME(),CGEXT);

 OUTS("WELCOME TO GENOA, VERSION 1.6.*C*L");
 OUTS("COPYRIGHT (C) 1980 BY THE BOARD OF TRUSTEES OF THE LELAND STANFORD*C*L")
 OUTS("JUNIOR UNIVERSITY.*C*L")
OUTS("GENOA IS A PROGRAM FOR COMPUTER-ASSISTED STRUCTURE ELUCIDATION*C*L")
OUTS("DEVELOPED WITH NIH SUPPORT BY THE DENDRAL GROUP AT STANFORD.*C*L")
 IF YESNO("MAY I RECORD YOUR SESSION?:","GENOA-HELP","YES") DO
  $(
  ENDWRITE(CREATEFILE("DSK",RECFILENAME(),CGEXT));
  RECINIT();
  FLUSHLINE();
  LINEIN("PLEASE TYPE YOUR NAME:") REPEATWHILE NEXTIS(EOLTYPE);
  UNTIL NEXTIS(EOLTYPE) DO LOPITEM()
  $)

 STEREOSTRUCS:=FALSE
 $);

LET LINELIST(INFN) = VALOF
 $( STATIC $( ANS = NIL $);
 ANS:=@NULL;
 UNTIL NEXTIS(EOLTYPE) DO ANS:=CONS(INFN(),ANS);
 RESULTIS DREVERSE(ANS)
 $);

LET INPR() = VALOF
 $( STATIC $( CARV = NIL; CDRV = NIL $);
 CARV:=LOPITEM();
 CDRV:=LOPITEM();
 RESULTIS CONS(CARV,CDRV)
 $);


LET DEFATOM(STRNUM,VALENCE) BE
 $( STATIC $( DEFINED = NIL $);
 OPENIN(TOPFILENAME);
 OPENOUT(SC1FILENAME);
 COPYSEGSTO(CHUNKSEP,ESHEADSTR,TRUE);
 DEFINED:=COPYSEGSTO(ESSEP,STROFNUM(STRNUM),TRUE);
 TEST DEFINED THEN SKIPSEG(ESSEP)
 OR $( OUTSNUM(STRNUM); NEWLINE(1) $);
 OUTS("ATOM ");
 OUTNOL(VALENCE);
 OUTCH(ESSEP);
 UNLESS DEFINED DO NEWLINE(1);
 COPYTOEND();
 CLOSEIN();
 CLOSEOUT();
 INTERRUPTABLE(FALSE);
 FILEREPLACE(TOPFILENAME(),CGEXT,SC1FILENAME(),CGEXT);
 OUTSNUM(STRNUM);
 TEST DEFINED THEN
  $(
  FRPLACA(CDR(CDR(ASSOC(STRNUM,ALLDEFS))),VALENCE);
  OUTS(" REDEFINED")
  $)
 OR
  $(
  ALLDEFS:=CONS(LIST(STRNUM,NUMOFSTR("ATOM"),VALENCE),ALLDEFS);
  OUTS(" DEFINED")
  $);
 NEWLINE(1);
 INTERRUPTABLE(TRUE)
 $);

LET DEFSUB(STRNUM) BE
 $(
 OPENOUT(SC1FILENAME);
 OUTS("EDIT SUBSTRUCTURE ");
 OUTSNUM(STRNUM);
 SPACES(1);
 OUTNOL(TERMTYPE);
 WRITERETTOME(THISPARTSTR);
 LINEOUT();
 CLOSEOUT();
 STARTCGPART1(DNDPPN,"EDITS")
 $);

LET DEFTYPEOF(STRNUM) = VALOF
 $( STATIC $( DEFTYPE = NIL $);
 DEFTYPE:=ASSOC(STRNUM,ALLDEFS);
 RESULTIS (DEFTYPE=@NULL -> 0,CAR(CDR(DEFTYPE)))
 $);

LET DEFNAMEIN(PROMPT,QQSTR,TYPESTR) = VALOF
 $( STATIC $( DEFNAME = NIL; DEFTYPE = NIL; QTAB = [TABLE 2,0,0] $);
 TEST TYPESTR=0 THEN
  $(
  QTAB!1:="A NAME (OTHER THAN X OR H) WHICH HAS";
  QTAB!2:="NOT PREVIOUSLY BEEN DEFINED"
  $)
 OR
  $(
  QTAB!1:="THE NAME OF A DEFINED";
  QTAB!2:=TYPESTR
  $);
 TRYPROMPT:
 UNLESS CONDPROMPT(PROMPT,0,QTAB,QQSTR,STV) DO RESULTIS 0;
 DEFNAME:=LITEMS![LPOSN+1];
 DEFTYPE:=DEFTYPEOF(DEFNAME);
 IF [DEFNAME=XSTRNUM] BITOR [DEFNAME=HSTRNUM] DO
  $(
  OUTS("THE NAMES X AND H HAVE SPECIAL MEANINGS AND CAN'T BE USED HERE*C*L");
  FLUSHLINE();
  GOTO TRYPROMPT
  $);
 IF TYPESTR=0 DO
  TEST DEFTYPE=0 THEN $( LOPITEM(); RESULTIS DEFNAME $)
  OR
   $(
   OUTSNUM(DEFNAME);
   OUTS(" IS ALREADY DEFINED AS ");
   PIART(STROFNUM(DEFTYPE));
   OUTS(" AND CAN'T BE USED HERE*C*L");
   FLUSHLINE();
   GOTO TRYPROMPT
   $);
 IF DEFTYPE=0 DO
  $( 
  OUTSNUM(DEFNAME);
  OUTS(" HASN'T BEEN DEFINED YET*C*L");
  FLUSHLINE();
  GOTO TRYPROMPT
  $);
 UNLESS STREQUAL(TYPESTR,STROFNUM(DEFTYPE)) DO
  $(
  OUTS(STROFNUM(DEFNAME));
  OUTS(" IS ");
  PIART(STROFNUM(DEFTYPE));
  OUTS(" BUT I WAS EXPECTING ");
  PIART(TYPESTR);
  NEWLINE(1);
  FLUSHLINE();
  GOTO TRYPROMPT
  $);
 LOPITEM();
 RESULTIS DEFNAME
 $);

LET SUBNAMEIN(PROMPT,QQSTR) = DEFNAMEIN(PROMPT,QQSTR,"SUBSTRUCTURE");

LET VALENCE(STRNUM) = VALOF
 $( STATIC $( DEFTYPE = NIL $);
 DEFTYPE:=DEFTYPEOF(STRNUM);
 IF DEFTYPE=0 DO RESULTIS -1;
 IF STREQUAL("ATOM",STROFNUM(DEFTYPE)) DO
  RESULTIS CAR(CDR(CDR(ASSOC(STRNUM,ALLDEFS))))
 RESULTIS -1
 $);



LET MFTWOU(MOLFORM) = VALOF
 $( STATIC $( TWOU = NIL $);
 TWOU:=2;
 WHILE MOLFORM NE @NULL DO
  $(
  TWOU:=TWOU+CDR(CAR(MOLFORM))*[VALENCE(CAR(CAR(MOLFORM)))-2];
  MOLFORM:=CDR(MOLFORM)
  $);
 RESULTIS TWOU
 $);

LET MFCHECK(CL) = VALOF
//MODIFIED FROM CONGEN - HERE NEEDS DEAL ONLY W/ ATOMS, BUT SOME DETAILS
//HAVE NOT BEEN REMOVED FROM THE CONGEN VERSION.  COULD BE MADE SIMPLER
 $( STATIC $( TWOU = NIL; HCOUNT = NIL; HMAX = NIL; LMAX = NIL; SUMV = NIL;
              SUMHMAX = NIL; XMAX = NIL; XMAXH = NIL; XMAXAT = NIL; NNONH = NIL;
              MAXFLEX = NIL; AQPR = NIL; ATQ = NIL; SAPROPENTRY = NIL; V = NIL;
              LMIN = NIL; X = NIL; ATNAME = NIL $);
 TWOU:=2;
 HCOUNT:=0;
 SUMV:=0;
 SUMHMAX:=0;
 XMAX:=0;
 NNONH:=0;
 MAXFLEX:=FALSE;
 WHILE CL NE @NULL DO
  $(
  AQPR:=CAR(CL);
  CL:=CDR(CL);
  ATNAME:=CAR(AQPR);
  ATQ:=CDR(AQPR);
  V:=CAR(CDR(CDR(ASSOC(ATNAME,ALLDEFS))));
  HMAX:=V-1;
  MAXFLEX:=TRUE;
  LMIN:=0;
  LMAX:=0
  TEST ATNAME=HSTRNUM THEN $( HCOUNT:=ATQ; TWOU:=TWOU-ATQ $)
  OR
   $(
   NNONH:=NNONH+ATQ;
   SUMV:=SUMV+ATQ*V
   SUMHMAX:=SUMHMAX+ATQ*HMAX;
   TWOU:=TWOU+ATQ*[V-2];
   X:=V-LMAX;
   IF X>XMAX DO $( XMAX:=X; XMAXH:=HMAX; XMAXAT:=ATNAME $);
   $)
  $);
 IF [NNONH=1] BITAND MAXFLEX DO $( SUMHMAX:=SUMHMAX+1; XMAXH:=XMAXH+1 $);
 IF TWOU<0 DO RESULTIS -1;
 IF [TWOU REM 2]=1 DO RESULTIS -2;
 IF HCOUNT>SUMHMAX DO RESULTIS -3;
 IF XMAX>0 DO
  $(
  IF XMAXH>HCOUNT DO XMAXH:=HCOUNT;
  IF 2*XMAX>SUMV+XMAXH DO RESULTIS XMAXAT
  $);
 RESULTIS 0
 $);

LET DEFMOLF(QQSTR) = VALOF
 $( STATIC $( NEWMOLF = NIL; NEWATS = NIL; ATNAME = NIL; ATVLNC = NIL;
              DTYPE = NIL; REDEF = NIL; MFERR = NIL $);
 NEWMOLF:=@NULL;
 NEWATS:=@NULL;
 IF CAR(STRUCSTATUS)>0 DO
  $(
  OUTS("THE MOLECULAR FORMULA CAN'T BE CHANGED AT THIS POINT SINCE ALL*C*L");
  OUTS("OF THE CASES I HAVE CONSTRUCTED SO FAR REFLECT THE OLD FORMULA.*C*L");
  RETURN
  $);
 TRYPROMPT:
 UNLESS CONDPROMPT("MOLECULAR FORMULA:",0,[TABLE 2,
  "A LIST OF ATOM NAMES AND QUANTITIES (ONES MAY BE OMITTED), SEPARATED",
  "BY BLANKS OR COMMAS (E.G., C 4 H 5 BR)"],QQSTR,STV) DO
  RESULTIS FALSE;
 NEXTNAME:
 UNLESS NEXTIS(STRTYPE) DO
  $( OUTS("I WAS EXPECTING A WORD HERE*C*L"); GOTO REPROMPT $);
 IF BADNAME([TABLE 1,"X"],
            "PLEASE DON'T USE THE NAME X IN THE MOLECULAR FORMULA") DO
  GOTO REPROMPT;
 ATNAME:=LOPITEM();
 DTYPE:=DEFTYPEOF(ATNAME);
 TEST DTYPE=0 THEN NEWATS:=CONS(ATNAME,NEWATS)
 OR
  UNLESS STREQUAL("ATOM",STROFNUM(DTYPE)) DO
   $(
   OUTSNUM(ATNAME);
   OUTS(" IS ");
   PIART(STROFNUM(DTYPE));
   OUTS(" AND CAN'T BE USED IN THE MOLECULAR FORMULA*C*L");
   GOTO REPROMPT
   $);
 NEWMOLF:=CONS(CONS(ATNAME,(NEXTIS(NUMTYPE) -> LOPITEM(),1)),NEWMOLF);
 UNLESS NEXTIS(EOLTYPE) BITOR NEXTIS(PSEOLTYPE) DO GOTO NEXTNAME;
 IF NEXTIS(PSEOLTYPE) DO LOPITEM();
 NEWATS:=DREVERSE(NEWATS)
 WHILE NEWATS NE @NULL DO
  $(
  ATNAME:=CAR(NEWATS);
  NEWATS:=UNCONS(NEWATS);
  OUTS("DEFINING ATOM ");
  OUTSNUM(ATNAME);
  OUTS("...*C*L");
  ATVLNC:=GETPOSINT("VALENCE:",QQSTR,FALSE);
  IF ATVLNC<0 DO GOTO REPROMPT;
  DEFATOM(ATNAME,ATVLNC)
  $);
 MFERR:=MFCHECK(NEWMOLF)
 IF MFERR NE 0 DO
  $(
  SWITCHON MFERR INTO
   $(
   CASE -1:
    OUTS("CONNECTED STRUCTURES CAN'T BE BUILT FROM THAT FORMULA*C*L");
    ENDCASE;
   CASE -2:
    OUTS("THAT FORMULA IMPLIES AN UNPAIRED ELECTRON ON SOME ATOM*C*L");
    ENDCASE;
   CASE -3:
    OUTS("PROGRAM ERROR - CONTACT GENOA DEVELOPERS*C*L");
    ENDCASE;
   DEFAULT:
    OUTS("IN THAT FORMULA, THERE IS NO WAY TO SATISFY THE VALENCE OF ");
    OUTSNUM(MFERR);
    NEWLINE(1)
   $);
  GOTO REPROMPT
  $);
 NEWMOLF:=DREVERSE(NEWMOLF);
 REDEF:=[MOLFORM NE @NULL];
 MAPC(MOLFORM,UNCONS);
 UNLIST(MOLFORM);
 MOLFORM:=NEWMOLF;
 OPENIN(TOPFILENAME);
 OPENOUT(SC1FILENAME);
 COPYSEGSTO(CHUNKSEP,MFHEADSTR,TRUE);
 SKIPSEG(CHUNKSEP);
 WHILE NEWMOLF NE @NULL DO
  $(
  OUTSNUM(CAR(CAR(NEWMOLF)));
  SPACES(1);
  OUTNOS(CDR(CAR(NEWMOLF)));
  NEWMOLF:=CDR(NEWMOLF)
  $);
 NEWLINE(1);
 OUTCH(CHUNKSEP);
 COPYTOEND();
 CLOSEIN();
 CLOSEOUT();
 INTERRUPTABLE(FALSE);
 FILEREPLACE(TOPFILENAME(),CGEXT,SC1FILENAME(),CGEXT);
 OUTS("MOLECULAR FORMULA ");
 IF REDEF THEN OUTS("RE");
 OUTS("DEFINED*C*L");
 INTERRUPTABLE(TRUE);
 RESULTIS TRUE;
 REPROMPT:
 UNLIST(NEWATS);
 NEWATS:=@NULL;
 MAPC(NEWMOLF,UNCONS);
 UNLIST(NEWMOLF);
 NEWMOLF:=@NULL;
 FLUSHLINE();
 GOTO TRYPROMPT
 $);



LET HIGHPCENTRY(STRNUM) = ASSOC(STRNUM,PREVCONS);

LET ALTERNATEUSE(STRNUM) = ASSOC(STRNUM,ALTS);

LET CANTCHANGE(STRNUM) = VALOF
//A VALUE OF FALSE HERE MEANS THAT IT IS OK TO CHANGE THE DEFINITION OF THE
//ITEM NAMED BY STRNUM
//A TRUE VALUE MEANS THE CHANGE SHOULDN'T BE DONE
 $( STATIC $( ERRTYPE = NIL $);
 ERRTYPE:=(ASSOC(STRNUM,MOLFORM) NE @NULL -> 1,
           (HIGHPCENTRY(STRNUM) NE @NULL -> 2,
            (ALTERNATEUSE(STRNUM) NE @NULL -> 2,0)));
 IF ERRTYPE=0 DO RESULTIS FALSE;
 UNLESS ERRTYPE=1 DO IF CAR(STRUCSTATUS)=0 DO RESULTIS FALSE;
 OUTS("CHANGING OR FORGETTING THE DEFINITION OF ");
 OUTSNUM(STRNUM);
 OUTS(" AT THIS POINT ISN'T*C*L");
 TEST CAR(STRUCSTATUS)=0 THEN
  OUTS("ALLOWED BECAUSE THAT ATOM IS PART OF THE MOLECULAR FORMULA*C*L")
 OR
  $(
  OUTS("ALLOWED BECAUSE THAT DEFINITION IS AN INTEGRAL PART OF THE CASES*C*L");
  OUTS("I HAVE CONSTRUCTED.*C*L")
  $);
 RESULTIS TRUE
 $);



LET DEFTT(QQSTR) BE
 $( STATIC $( NTT = NIL $);
 OUTS("OLD TERMINAL TYPE IS ");
 OUTNOL(TERMTYPE);
 TRYPROMPT:
 UNLESS CONDPROMPT("NEW TERMINAL TYPE:",0,
     [TABLE 15,
     "3 FOR MEGATEK, 4 FOR TEKTRONIX, 5 FOR GT40,",
     "OR FOR TELETYPE DRAWINGS,",
     "SELECT THE NUMBER CORRESPONDING TO THE DRAWING BELOW WHICH LOOKS",
     "MOST LIKE TETRAHEDRANE:",
     "1     C",
     "     /|\",
     "    C--*B|-C",
     "     \|/",
     "      C",
     "",
     "2     C",
     "     /!\",
     "    C---C*C      !",
     "     \!/",
     "      C"],                          QQSTR,NTV) DO RETURN;
 NTT:=LOPITEM();
 IF [NTT<1] BITOR [NTT>5] DO
  $(
  OUTS("I DON'T UNDERSTAND - TYPE ? FOR HELP*C*L");
  FLUSHLINE();
  GOTO TRYPROMPT
  $);
 OPENIN(TOPFILENAME);
 OPENOUT(SC1FILENAME);
 COPYSEGSTO(CHUNKSEP,TTHEADSTR,TRUE);
 OUTNOL(NTT);
 OUTCH(CHUNKSEP);
 SKIPSEG(CHUNKSEP);
 COPYTOEND();
 CLOSEIN();
 CLOSEOUT();
 INTERRUPTABLE(FALSE);
 FILEREPLACE(TOPFILENAME(),CGEXT,SC1FILENAME(),CGEXT);
 TERMTYPE:=NTT;
 OUTS("THE TERMINAL TYPE HAS BEEN RESET TO ");
 OUTNOL(NTT);
 INTERRUPTABLE(TRUE)
 $);


LET CGDEFINE(FIXFLAG) BE
 $( STATIC $( DEFTYPE = NIL; DEFNAME = NIL; VALENCE = NIL; QQSTR = NIL $);
 QQSTR:=(FIXFLAG -> "FIX-HELP","DEFINE-HELP");
 DEFTYPE:=PROMPTSELECT("DEFINITION TYPE:",
                       "ATOM SUBSTRUCTURE MOLFORM TERMTYPE",
                       0,QQSTR,[TABLE 4,"ATOM",1,"SUBSTRUCTURE",2,
                       "MOLFORM",4,"TERMTYPE",5,0],FALSE);
 IF DEFTYPE=0 DO RETURN;
 IF DEFTYPE=5 DO $( DEFTT(QQSTR); RETURN $);
 IF DEFTYPE=4 DO
  TEST FIXFLAG THEN
   TEST MOLFORM=@NULL THEN
    $(
    OUTS("THE MOLECULAR FORMULA HASN'T BEEN DEFINED YET*C*L");
    FLUSHLINE();
    RETURN
    $)
   OR $( DEFMOLF(QQSTR); RETURN $)
  OR
   TEST MOLFORM=@NULL THEN $( DEFMOLF(QQSTR); RETURN $)
   OR
    $(
    OUTS("THE MOLECULAR FORMULA IS ALREADY DEFINED.*C*L");
    IF CAR(STRUCSTATUS)=0 DO
     OUTS("PLEASE USE THE FIX COMMAND IF YOU WANT TO CHANGE IT.*C*L");
    FLUSHLINE();
    RETURN
    $);
 DEFNAME:=DEFNAMEIN("NAME:",QQSTR,
                    (FIXFLAG -> (DEFTYPE=1 -> "ATOM","SUBSTRUCTURE"),0));
 IF DEFNAME=0 DO RETURN;
 IF FIXFLAG DO
  IF CANTCHANGE(DEFNAME) DO $( FLUSHLINE(); RETURN $);
 SWITCHON DEFTYPE INTO
  $(
  CASE 1:
   VALENCE:=GETPOSINT("VALENCE:",QQSTR,FALSE);
   IF VALENCE=-1 DO RETURN;
   DEFATOM(DEFNAME,VALENCE);
   ENDCASE;
  CASE 2:
   DEFSUB(DEFNAME)
  $)
 $);

LET RANGEREADER(PROMPT,QQSTR,POSMINFLAG) = VALOF
 $( STATIC $( RTYPE = NIL; NUM = NIL; NUM2 = NIL; OPTIONS =
      "NONE     AT LEAST X     AT MOST X     EXACTLY X     RANGE X TO Y";
              POSMINOPTIONS = "AT LEAST X     EXACTLY X     RANGE X TO Y";
              OPTTABLE = [TABLE 6, "NONE",1,"LEAST",2,"MOST",3,"EXACTLY",4,
              "RANGE",5,"AT",6,0]; POSMINOPTTABLE = [TABLE 4,"LEAST",2,
              "EXACTLY",4,"RANGE",5,"AT",6,0]; QTABLE = [TABLE 4,
     "PLEASE GIVE ME A RANGE IN ONE OF THE FOLLOWING FORMS:",0,
     "WHERE X AND Y ARE POSITIVE INTEGERS (LESS THAN 100) WHICH YOU SUPPLY",
     "THE WORDS 'AT' AND 'TO' ARE OPTIONAL"] $);
 QTABLE!2:=(POSMINFLAG -> POSMINOPTIONS,OPTIONS);
 TRYPROMPT:
 RTYPE:=PROMPTSELECT(PROMPT,0,QTABLE,QQSTR,(POSMINFLAG -> POSMINOPTTABLE,
                      OPTTABLE),FALSE);
 SWITCHON RTYPE INTO
  $(
  CASE 0: RESULTIS @NULL;
  CASE 1: RESULTIS CONS(0,0);
  CASE 6:
   TEST POSMINFLAG THEN
    $(
    TEST NEXTIS(STRTYPE) THEN
     TEST STRCONTAIN(STROFNUM(LITEMS![LPOSN+1]),"LEAST") THEN LOPITEM()
     OR GOTO REPROMPT
    OR OUTS("I ASSUME YOU MEAN 'AT LEAST'*C*L");
    RTYPE:=2
    $)
   OR
    $(
    RTYPE:=PROMPTSELECT("LEAST OR MOST?:","LEAST MOST",0,QQSTR,
                        [TABLE 2,"LEAST",2,"MOST",3,0],FALSE);
    IF RTYPE=0 DO GOTO REPROMPT
    $)
  $);
 NUM:=GETPOSINT((RTYPE=5 -> "BEGINNING OF RANGE:","NUMBER:"),QQSTR,FALSE);
 IF [NUM<0] BITOR [NUM GE 100] DO GOTO REPROMPT;
 SWITCHON RTYPE INTO
  $(
  CASE 2: RESULTIS CONS(NUM,100);
  CASE 3: RESULTIS CONS(0,NUM);
  CASE 4: RESULTIS CONS(NUM,NUM)
  $);
 IF NEXTIS(STRTYPE) DO
  UNLESS STRCONTAIN(STROFNUM(LOPITEM()),"TO") DO GOTO REPROMPT;
 NUM2:=GETPOSINT("END OF RANGE:",QQSTR,FALSE);
 IF [NUM2>0] BITOR [NUM2 GE 100] DO
  RESULTIS (NUM2>NUM -> CONS(NUM,NUM2),CONS(NUM2,NUM));
 REPROMPT:
 OUTS("I DON'T UNDERSTAND - TYPE ? FOR HELP*C*L");
 FLUSHLINE();
 GOTO TRYPROMPT
 $);

LET FETCHSUB(SUBNAME) BE
 $(
 OPENIN(TOPFILENAME);
 FINDSEG(CHUNKSEP,ESHEADSTR);
 FINDSEG(ESSEP,STROFNUM(SUBNAME));
 SKIPSEG('*L');
 READESSTRUC();
 CLOSEIN()
 $);

LET ATOMPRESENT(ATNAME) =
 (ATNAME=XSTRNUM -> TRUE,[ASSOC(ATNAME,MODMF) NE @NULL]);

LET CTEATOMSABSENT(CTE) = VALOF
 $( STATIC $( TATS = NIL; TATAIL = NIL; PRES = NIL $);
 TATS:=FETCH(CTE.ATS,CTE);
 TATAIL:=TATS;
 PRES:=@NULL;
  $(
  TATAIL:=SOME(TATAIL,ATOMPRESENT);
  IF TATAIL=@NULL DO BREAK;
  PRES:=CONS(CAR(TATAIL),PRES);
  TATAIL:=CDR(TATAIL)
  $) REPEAT;
 IF PRES=@NULL DO RESULTIS TRUE;
 UNLIST(TATS);
 REPLACE(CTE.ATS,CTE,PRES);
 RESULTIS FALSE
 $);

LET PNOSENSE(STRNUM) BE
 $(
 OUTS("TESTING FOR ");
 OUTSNUM(STRNUM);
 OUTS(" DOESN'T MAKE SENSE HERE BECAUSE*C*L")
 $);

LET CONATOMSPRESENT(TELLUSER,CNSTRNUM) = VALOF
 $( STATIC $( ERRATS = NIL; TCTELIST = NIL $);
 TCTELIST:=CTELIST;
 ERRATS:=@NULL;
 WHILE TCTELIST NE @NULL DO
  $(
  IF CTEATOMSABSENT(CAR(TCTELIST)) DO
   ERRATS:=CONS(FETCH(CTE.NUM,CAR(TCTELIST)),ERRATS);
  TCTELIST:=CDR(TCTELIST)
  $);
 IF ERRATS=@NULL DO RESULTIS TRUE;
 UNLESS TELLUSER DO $( UNLIST(ERRATS); RESULTIS FALSE $);
 PNOSENSE(CNSTRNUM);
 OUTS((CDR(ERRATS)=@NULL -> "ATOM","ATOMS"));
 PLIST(ERRATS,OUTNO," ",", "," AND "," CAN'T MATCH ANY OF THE ATOMS WHICH*C*L");
 OUTS("WILL BE PRESENT WHEN I APPLY THE TEST*C*L");
 RESULTIS FALSE
 $);



GET "GLSSCH.BCP"

LET ONETAGP(STRNUM) = VALOF
 $( STATIC $( TAGTAIL = NIL $);
 TAGTAIL:=SOME(CTELIST,TAGP);
 IF TAGTAIL NE @NULL DO
  IF SOME(CDR(TAGTAIL),TAGP)=@NULL DO RESULTIS TRUE;
 OUTS("PROTON-CONSTRAINT SUBSTRUCTURES SHOULD HAVE EXACTLY ONE TAG, BUT*C*L");
 OUTSNUM(STRNUM);
 OUTS((TAGTAIL=@NULL -> " DOESN'T HAVE ANY.*C*L"," HAS MORE THAN ONE.*C*L"));
 FLUSHLINE();
 RESULTIS FALSE
 $);

LET CONSTRAINTCHECK(TELLUSER,STRNUM,PTFLAG) = VALOF
 $( STATIC $( CONCOMP = NIL; DEFICITS = NIL; AQPR = NIL $);
 IF PTFLAG DO UNLESS ONETAGP(STRNUM) DO RESULTIS FALSE;
 UNLESS CONATOMSPRESENT(TELLUSER,STRNUM) DO RESULTIS FALSE;
 CONCOMP:=SSCHECK(STRNUM,"I CAN'T USE ",TELLUSER);
 IF CONCOMP=0 DO RESULTIS FALSE;
 DEFICITS:=@NULL;
 WHILE CONCOMP NE @NULL DO
  $(
  AQPR:=CAR(CONCOMP);
  CONCOMP:=UNCONS(CONCOMP);
  IF CDR(AQPR)>CDR(ASSOC(CAR(AQPR),MODMF)) DO
   DEFICITS:=CONS(CAR(AQPR),DEFICITS);
  UNCONS(AQPR)
  $);
 IF DEFICITS NE @NULL DO
  $(
  IF TELLUSER DO
   $(
   PNOSENSE(STRNUM);
   OUTS("IT CONTAINS MORE ATOMS OF TYPE");
   IF CDR(DEFICITS) NE @NULL DO OUTCH('S');
   PLIST(DEFICITS,OUTSNUM," ",", "," AND ","*C*L");
   OUTS("THAN WILL BE PRESENT WHEN I APPLY THE TEST*C*L")
   $);
  UNLIST(DEFICITS);
  RESULTIS FALSE
  $);
 RESULTIS TRUE
 $);

LET AVOUT(MFENTRY) BE
 $( STATIC $( ATNAME = NIL $);
 ATNAME:=CAR(MFENTRY);
 IF HSTRNUM=ATNAME DO RETURN;
 OUTSNUM(ATNAME);
 SPACES(1);
 OUTNO(VALENCE(ATNAME))
 $);

LET PRINATN(PR) BE $( OUTSNUM(CAR(PR)); SPACES(1); OUTNO(CDR(PR)) $);

LET RANGEOUT(MIN,MAX,NONEFLAG) = VALOF
 $(
 IF MAX=0 DO $( OUTS((NONEFLAG -> "NONE","NO")); RESULTIS TRUE $);
 IF MAX=100 DO $( OUTS("AT LEAST "); OUTNO(MIN); RESULTIS [MIN NE 1] $);
 IF MIN=0 DO $( OUTS("AT MOST "); OUTNO(MAX); RESULTIS [MAX NE 1] $);
 IF MIN=MAX DO $( OUTS("EXACTLY "); OUTNO(MIN); RESULTIS [MIN NE 1] $);
 OUTS("FROM "); OUTNO(MIN); OUTS(" TO "); OUTNO(MAX); RESULTIS TRUE
 $);


LET RESETCONMM(STRNUM,MMPR,OMIN,OMAX) = VALOF
 $( STATIC $( NMIN = NIL; NMAX = NIL; MIN = NIL; MAX = NIL; ANYCHANGE = NIL $);

 LET MMMSG(STRNUM,OMIN,OMAX,STR) BE
  $(
  OUTS("YOUR PREVIOUS CONSTRAINTS SPECIFIED ");
  TEST RANGEOUT(OMIN,OMAX,FALSE) THEN
   $( SPACES(1); OUTSNUM(STRNUM); OUTS("'S") $)
  OR $( SPACES(1); OUTSNUM(STRNUM) $);
  NEWLINE(1);
  OUTS(STR);
  RANGEOUT(NMIN,NMAX,TRUE);
  OUTS(".*C*L")
  $);

 NMIN:=CAR(MMPR);
 NMAX:=CDR(MMPR);
 ANYCHANGE:=FALSE;
 TEST NMIN>OMIN THEN $( ANYCHANGE:=TRUE; MIN:=NMIN $)
 OR MIN:=OMIN;
 TEST NMAX<OMAX THEN $( ANYCHANGE:=TRUE; MAX:=NMAX $)
 OR MAX:=OMAX;
 UNLESS ANYCHANGE DO
  $(
  MMMSG(STRNUM,OMIN,OMAX,"SO IT IS NOT NECESSARY TO TEST FOR ");
  RESULTIS 0
  $);
 IF MIN>MAX DO
  $(
  MMMSG(STRNUM,OMIN,OMAX,"SO THERE CANNOT ALSO BE ");
  RESULTIS -1
  $);
 REPLND2(MMPR,MIN,MAX);
 RESULTIS 1
 $);

let VERIFYOUT(NAME,SCORE,MIN,MAX) be $(vf
  FETCHSUB(NAME)
  unless CONSTRAINTCHECK(FALSE,NAME,FALSE) do $(
	ENDWRITE(OUTPUT); OUTPUT:=TTY
	OUTS("GENOA error, substructure definitions changed!")
	finish
	$)
  PASSESSTRUCOUT()
  CONLENGTHS:=CONS(LENGTH(CTELIST),CONLENGTHS)
  OUTS("N*C*L"); 
  OUTNOS(MIN); OUTNOL(MAX)
  OUTNOL(SCORE)
  CLEAR()
$)vf




let COPYOLDONES(OMITLIST) be $(cpyld

/* It is fastest to go through all current substructures and see if
they are used in Previous constraints (with specific upper limits)
or in ALTERNATIVES (with non-zero scores)
However, then have to be a bit more careful about current
CONSTRAINT or set of alternatives; so have argument OMITLIST
which contains names of substructures of current interest,
the appropriate data will already have been written out
for these so that they should be ignored when found during
pass through all substructures.



CHANGED !!!!!

*/
 static $( OIN = NIL; OOUT  = NIL; SUBNAME = NIL; XX = NIL; XXMIN = NIL; XXMAX = NIL; XXSCR = NIL $)
 OIN:=INPUT
 INPUT:=FINDFILE("DSK",TOPFILENAME(),CGEXT)
 FINDSEG(CHUNKSEP,ESHEADSTR)
 $(RPT
 SKIPSEG(ESSEP)
 SUBNAME:=INS0(TRUE)
 if NCHARS(SUBNAME)=0 then break
 SUBNAME:=NUMOFSTR(SUBNAME)
 SKIPSEG('*L')
//? OOUT:=OUTPUT; OUTPUT:=TTY; OUTS("*C*Lchecking "); OUTSNUM(SUBNAME); OUTPUT:=OOUT
 if ASSOC(SUBNAME,OMITLIST) NE @NULL then loop

 XX:=ASSOC(SUBNAME,PREVCONS)
 if XX NE @NULL do $(oldconstraint
//? OUTS(" (old constraint)")
	XXMIN:=CAR(CDR(CDR(XX)))
	XXMAX:=CAR(CDR(CDR(CDR(XX))))
	unless XXMAX GE 100 do VERIFYOUT(SUBNAME,0,XXMIN,XXMAX)
	loop
 	$)oldconstraint
 XX:=ASSOC(SUBNAME,ALTS)
 if XX NE @NULL do $(oldalternative
//? OUTS(" (old alternative)")
	/* Get score, and convert allowing for offset relative to CFMAX. */
	XXSCR:=CDR(XX)-CFMAX
	unless XXSCR=0 do VERIFYOUT(SUBNAME,XXSCR,1,100)
	loop
	$)oldalternative
 $)RPT REPEAT
 ENDREAD(INPUT)
 INPUT:=OIN
$)cpyld


let LISTALTS(ALTS) be $(Lstlt
   static $( TMP = NIL; ENTRY = NIL; SUBNAME = NIL; SUBSCORE = NIL $)
   OUTNOL(LENGTH(ALTS));  
   TMP:=ALTS; 
   UNTIL TMP=@NULL DO $(NAMES
	    ENTRY:=CAR(TMP);
	    TMP:=CDR(TMP);
	    SUBNAME:=CAR(ENTRY);
	    OUTSNUM(SUBNAME);SPACES(1);
	    SUBSCORE:=CDR(ENTRY);
	    /* Because cannot have -ve numbers in lists, scores are held
		offset to CFMAX. 
		As this set of scores has to be read again from history
		list etc, leave them with the offset.
	    */
	    OUTNOL(SUBSCORE)
	    $)NAMES
$)Lstlt




let PUTMINGENSCORE() be $(
static $( MINSCORE = NIL; OOUT = NIL; SCORESUSED = NIL $)
 
 let CHKSCORES(ITEM) be $(
  unless CDR(ITEM)=CFMAX do SCORESUSED:=TRUE
  $)

MINSCORE:=MINUSINF
SCORESUSED:=FALSE
unless ALTS=@NULL do MAPC(ALTS,CHKSCORES)
if SCORESUSED do $(
	OOUT:=OUTPUT
	OUTPUT:=TTY
	unless CONDPROMPT("Minimum acceptable score for generated structures : ",
	"a low cutoff limit",0,QQSTR,NTV) do;
	MINSCORE:=LOPITEM()
	OUTPUT:=OOUT
	$)

OUTNOL(MINSCORE)
$)


let REWORKFILES(MODE,ALTS,STRING,NUMBER) be $(rwk

 /* Now need to reorganise the file of data for GLBLD. In "SC2" have
 connection tables for all the substructures that are being passed.
 But, GLBLD needs other info first --- like the number of atoms
 in each of the substructures.
 So, write this additional data into SC1 and the copy the contents
 of SC2 in at the end.

 "MODE" is an integer defining how GLBLD should operate 1=>generate,
        (generate now takes and extra data item, minimum score)
	2=>constraint, 3 (or more)=> some form of "ALTERNATIVE",
	if MODE>=3 then may have extra data,
	will have ALTS a list of ALTERNATIVES with their scores
	may have STRING, and NUMBER (as in MS functions).
 */

 static $( HCOUNT = NIL; OIN = NIL; OOUT = NIL $)

 LET OUTNOCDR(PR) BE
  TEST HSTRNUM=CAR(PR) THEN HCOUNT:=CDR(PR) OR OUTNO(CDR(PR));


 OOUT:=OUTPUT
 CONLENGTHS:=DREVERSE(CONLENGTHS);
 OUTPUT:=CREATEFILE("DSK",SC1FILENAME(),CGEXT);
 WRITERETTOME(THISPARTSTR);
 OUTNOL((ASSOC(HSTRNUM,MOLFORM)=@NULL -> LENGTH(MOLFORM),[LENGTH(MOLFORM)-1]));
 PLIST(MOLFORM,AVOUT,""," "," ","*C*L");
 IF CAR(STRUCSTATUS)=0 DO
  $(
  WHILE FILEEXISTS(STRFILENAME(),CGEXT) DO DELETEFILE(STRFILENAME(),CGEXT);
  HCOUNT:=0;
  PLIST(MOLFORM,OUTNOCDR,""," "," ","*C*L");
  OUTNOL(HCOUNT)
  $);
 OUTNOL(LENGTH(CONLENGTHS));
 PLIST(CONLENGTHS,OUTNO,""," "," ","*C*L");
 UNLIST(CONLENGTHS);
 CONLENGTHS:=@NULL;
 OUTNOL(MODE)
 SWITCHON MODE INTO $(sw
	CASE 1: PUTMINGENSCORE(); ENDCASE;
	CASE 2: OUTSNUM(STRING); NEWLINE(1); ENDCASE;
	CASE 3: LISTALTS(ALTS); ENDCASE;
	CASE 4: /* MS functions, have to output as a single string */
		/* a set of data held in the vectors STRING and */
		/* number. First element of either vector gives /
		/* number of entries. */
		for ii=1 to STRING!0 do $( OUTSNUM(STRING!ii); OUTNO(NUMBER!ii) $)
		NEWLINE(1); LISTALTS(ALTS)
		endcase;
	DEFAULT:
	$)sw
	     
 NEWLINE(1);
 OIN:=INPUT;
 INPUT:=FINDFILE("DSK",SC2FILENAME(),CGEXT);
 COPYTOEND();
 ENDREAD(INPUT);
 INPUT:=OIN;
 ENDWRITE(OUTPUT);
 OUTPUT:=OOUT;
 DELETEFILE(SC2FILENAME(),CGEXT)

$)rwk



LET CONSTRAINT(GENFLAG) BE
 $( STATIC $( SUBNAME = NIL; CMM = NIL; PREVE = NIL; OMM = NIL; OOUT = NIL;
              TPC = NIL; TPCE = NIL; OIN = NIL; TEM = NIL $);


 IF MOLFORM=@NULL DO
  UNLESS DEFMOLF("CONSTRAINT-HELP") DO
   $(
   FLUSHLINE();
   OUTS((GENFLAG -> "I CAN'T GENERATE ANY STRUCTURES ",
                    "I CAN'T APPLY ANY CONSTRAINTS "));
   OUTS("WITHOUT THE MOLECULAR FORMULA*C*L");
   RETURN
   $);


 MODMF:=MOLFORM;
 CONLENGTHS:=@NULL;

 test GENFLAG then $(gen
	/* If generating, then merely need to copy all previously used
	constraints that specify definite upper limits etc, and reorganise
	the files.
	*/
	OOUT:=OUTPUT;
	OUTPUT:=CREATEFILE("DSK",SC2FILENAME(),CGEXT)
	COPYOLDONES(@NULL)
	ENDWRITE(OUTPUT)
	OUTPUT:=OOUT
	REWORKFILES(1,@NULL,0,0)
	$)gen
 or $(Newcon
  /* First, need to get a valid constraint. */

GETNAME:

  /* A valid constraint involves a substructure: */
  SUBNAME:=SUBNAMEIN("SUBSTRUCTURE NAME:","CONSTRAINT-HELP");
  IF SUBNAME=0 DO RETURN;


  /* And a meaningful range of occurrences: */
  CMM:=RANGEREADER("RANGE OF OCCURRENCES:","CONSTRAINT-HELP",FALSE);
  IF CMM=0 DO RETURN;

  /* Now, if the substructure has been used in a previous constraint
  may have inconsistencies, so check for this possiblility.
  */

  PREVE:=HIGHPCENTRY(SUBNAME);
  TEST PREVE=@NULL THEN
   $(notyetused
     UNLESS ASSOC(SUBNAME,ALTS)=@NULL DO $(
	OUTS("(note that this use of the substructure will overide its previous*C*L");
	OUTS("use as an ALTERNATIVE)*C*L")
	$)
     FETCHSUB(SUBNAME);
     UNLESS CONSTRAINTCHECK(TRUE,SUBNAME,FALSE) DO
        $(
        MODMF:=@NULL;
        UNCONS(CMM);
        CLEAR();
        FLUSHLINE();
        RETURN
       $);
   $)notyetused
  OR
   $(beenused
   /* Have to check that new limits are not inconsistent with
   old limits.
   */
     OMM:=CDR(CDR(PREVE));
     UNLESS RESETCONMM(SUBNAME,CMM,CAR(OMM),CAR(CDR(OMM)))=1 DO
       $(
       MODMF:=@NULL;
       UNCONS(CMM);
       FLUSHLINE();
       RETURN
       $)
     FETCHSUB(SUBNAME)
     unless CONSTRAINTCHECK(FALSE,SUBNAME,FALSE) do $(
	 OUTS("GENOA systems error, substructure definitions corrupted!*C*L")
	 finish
	 $)
   $)beenused
 OOUT:=OUTPUT;
 OUTPUT:=CREATEFILE("DSK",SC2FILENAME(),CGEXT)
 PASSESSTRUCOUT()
 OUTS("N*C*L")
 OUTNOS(CAR(CMM)); OUTNOL(CDR(CMM))
 OUTNOL(0)
 CONLENGTHS:=CONS(LENGTH(CTELIST),CONLENGTHS)
 CLEAR()
 TEM:=CONS(CONS(SUBNAME,@NULL),@NULL)
 COPYOLDONES(TEM);
 ENDWRITE(OUTPUT)
 OUTPUT:=OOUT
 REWORKFILES(2,@NULL,SUBNAME,0)
$)Newcon


 STARTCGPART1(DNDPPN,"GLBLD")
// STARTCGPART1(GRYPPN,(EMODE -> "GLBLD2","GLBLD1"))
 $);


LET BLEACH() BE $(blch
 STATIC $( OOUT = NIL $)

 IF (MOLFORM=@NULL) | (CAR(STRUCSTATUS)=0) DO
  $( OUTS("Nothing yet exists to be processed by this command.*C*L")
   $);



 OOUT:=OUTPUT
 OUTPUT:=CREATEFILE("DSK",SC1FILENAME(),CGEXT);
 WRITERETTOME(THISPARTSTR);
 OUTNOL((ASSOC(HSTRNUM,MOLFORM)=@NULL -> LENGTH(MOLFORM),[LENGTH(MOLFORM)-1]));
 PLIST(MOLFORM,AVOUT,""," "," ","*C*L");
 OUTS("0*C*L0*C*L0*C*L");
 ENDWRITE(OUTPUT);
 OUTPUT:=OOUT;

 STARTCGPART1(DNDPPN,"GLBLD")
 $)blch


LET ALTERNATE() BE
 $( STATIC $( SUBNAME = NIL; CMM = NIL; PREVE = NIL; OMM = NIL; OOUT = NIL;
        SUBSCORE = NIL; ENTRY = NIL;
	ALTLIST = NIL; TMP= NIL; OFILE = NIL;
              TPC = NIL; TPCE = NIL; OIN = NIL; TEM = NIL; HCOUNT = NIL $);


 IF MOLFORM=@NULL DO
  UNLESS DEFMOLF("CONSTRAINT-HELP") DO
   $(
   FLUSHLINE();
   OUTS( "I CAN'T APPLY ANY CONSTRAINTS ");
   OUTS("WITHOUT THE MOLECULAR FORMULA*C*L");
   RETURN
   $);
 MODMF:=MOLFORM;
 ALTLIST:=@NULL
RETRY:
 /* If get certain kinds of erroneous input may return here
  with a partly assembled ALTLIST, if so clear it out.
 */

 UNLESS ALTLIST=@NULL DO $( MAPC(ALTLIST,UNCONS); UNLIST(ALTLIST); ALTLIST:=@NULL $)

 UNLESS CONDPROMPT("ALTERNATIVE SUBSTRUCTURES AND SCORES : ",0,
   [TABLE 3,"A LIST OF NAMES OF SUBSTRUCTURES THAT YOU HAVE PREVIOUSLY DEFINED",
            "AND WHICH YOU WISH TO CONSIDER AS ALTERNATIVE EXPLANATIONS FOR OBSERVED DATA",
	    "TOGETHER WITH RELATIVE SCORES IN RANGE -99 TO 99."],
   QQSTR,STV)
  DO RETURN;

 $(RPT
   unless NEXTIS(STRTYPE) do $( OUTS("I was expecting a substructure name.*C*L")
				FLUSHLINE()
				goto RETRY
			      $)
   SUBNAME:=LOPITEM()
   /* Check that it is a defined substructure. */
   unless STREQUAL("SUBSTRUCTURE",STROFNUM(DEFTYPEOF(SUBNAME))) do $(
				OUTSNUM(SUBNAME);
				OUTS(" is not a defined substructure.");
				FLUSHLINE()
				goto RETRY
				$)

  PREVE:=HIGHPCENTRY(SUBNAME)
  UNLESS (PREVE=@NULL) & (ASSOC(SUBNAME,ALTS)=@NULL) DO $(BEENUSED
	OUTSNUM(SUBNAME)
	OUTS(" HAS BEEN USED IN CONSTRAINTS APPLIED EARLIER.*C*L")
	OUTS("IT CANNOT BE RE-USED.*C*L")
	FLUSHLINE()
	goto RETRY
	$)BEENUSED

   unless NEXTIS(NUMTYPE) do $( OUTS("I was expecting a relative score.*C*L")
			        FLUSHLINE()
				goto RETRY
			     $)
   SUBSCORE:=LOPITEM()
   unless (-CFMAX<SUBSCORE) & (SUBSCORE<CFMAX) do $(
				OUTNOS(SUBSCORE)
				OUTS(" is outside the allowed range for relative scores.*C*L")
				FLUSHLINE()
				goto RETRY
				$)
   /* Lists cannot be used for -ve numbers so store score offset by CFMAX. */
   ENTRY:=CONS(SUBNAME,SUBSCORE+CFMAX)
   ALTLIST:=CONS(ENTRY,ALTLIST)
  
  $)RPT REPEATUNTIL (NEXTIS(EOLTYPE) | NEXTIS(PSEOLTYPE));
 if ALTLIST=@NULL then RETURN

 TMP:=ALTLIST;

 OFILE:=CREATEFILE("DSK",SC2FILENAME(),CGEXT);

 CONLENGTHS:=@NULL;

 UNTIL TMP=@NULL DO $(STLST
  ENTRY:=CAR(TMP);
  SUBNAME:=CAR(ENTRY); SUBSCORE:=CDR(ENTRY)
  TMP:=CDR(TMP);

  FETCHSUB(SUBNAME);
  UNLESS CONSTRAINTCHECK(TRUE,SUBNAME,FALSE) DO
    $(NOGOOD
    CLEAR();
    GOTO BADONE
    $)NOGOOD

  OOUT:=OUTPUT; OUTPUT:=OFILE;
  PASSESSTRUCOUT();

  OUTS("N*C*L"); // NOT A PROTON PATTERN
  OUTS("1 100*C*L"); // RANGE OF OCCURRENCES.
  OUTNOL(SUBSCORE-CFMAX)
  CONLENGTHS:=CONS(LENGTH(CTELIST),CONLENGTHS)
  NEWLINE(1)
  CLEAR()
  OUTPUT:=OOUT
 $)STLST

 OUTPUT:=OFILE
 COPYOLDONES(ALTLIST)
 ENDWRITE(OUTPUT)
 OUTPUT:=OOUT
 REWORKFILES(3,ALTLIST,0,0)  

 STARTCGPART1(DNDPPN,"GLBLD")

BADONE:
 MAPC(ALTLIST,UNCONS)
 UNLIST(ALTLIST)
 ALTLIST:=@NULL
 MODMF:=@NULL
 UNLIST(CONLENGTHS)
 CONLENGTHS:=@NULL
 ENDWRITE(OFILE)
 DELETEFILE(SC2FILENAME(),CGEXT)
 $);


GET "PFILE.BCL"

LET GLIREFRESH() BE
 $( STATIC $( DEFNAME = NIL; ITEM = NIL; TMP = NIL; U = NIL $);

 LET FINDSEGP(CHUNKSEP,STR) BE
  IF FINDSEG(CHUNKSEP,STR)<0 DO 
   $( CLOSEIN(); OUTS("PLEASE RUN CGUPDATE ON THAT FILE*C*L"); EXIT(TRUE) $);

 OPENIN(TOPFILENAME);
 FINDSEGP(CHUNKSEP,MFHEADSTR);
 LINEIN("");
 MOLFORM:=LINELIST(INPR);
 FINDSEGP(CHUNKSEP,SSHEADSTR);
 LINEIN("");
 STRUCSTATUS:=LOPITEM();
 TEST STRUCSTATUS=0 THEN
  $(
  STRUCSTATUS:=LIST(0,0);
  MINSTRUCNO:=0;
  MAXSTRUCNO:=0
  $)
 OR
  $(
  LINEIN("");
  MINSTRUCNO:=LOPITEM();
  MAXSTRUCNO:=LOPITEM();
  LINEIN();
  U:=LOPITEM();
  STRUCSTATUS:=CONS(STRUCSTATUS,CONS(U,LINELIST(INPR)))
  $);
 FINDSEGP(CHUNKSEP,HIHEADSTR);
 LINEIN("");
 PREVCONS:=@NULL;
 ALTERNATES:=@NULL;
 UNTIL NEXTIS(EOLTYPE) DO
  $(
  ITEM:=LINELIST(LOPITEM); 
  TEST (CAR(ITEM)=NUMOFSTR("ALTERNATIVES") | CAR(ITEM)=NUMOFSTR("ION-COMPOSITION"))
  THEN ALTERNATES:=CONS(ITEM, ALTERNATES)
  OR
  UNLESS (CAR(ITEM)=NUMOFSTR("PRESUPPOSING")) DO 
     PREVCONS:=CONS( ITEM, PREVCONS);
  LINEIN("")
  $);
 PREVCONS:=DREVERSE(PREVCONS);
 ALTS:=@NULL;
 TMP:=ALTERNATES;
 /* Structure of list "ALTERNATES" should be something like
   ALTERNATIVES A 10 B 90
   ION-COMPOSITION C9H15O X1-1 10 X1-7 30 X2-5 50 NONE 10
   ALTERNATIVES SKELA 25 SKELB 25 SKELC 25 SKELD 25
 Now want to pick out the substructure names like A, X1-1 and SKELD.

 UNFORTUNATELY, there is a little problem related to things with -ve
 scores. -ve numers cannot be represented in lists. So, its necessary
 to store all scores offset by CFMAX. It doesn't affect code here but
 it changes interpretations elsewhere!

 */
 UNTIL TMP=@NULL DO $(
   ITEM:=CAR(TMP); TMP:=CDR(TMP);
   /* Either drop the one entry "ALTERNATIVES" or the double entry
    "ION-COMPOSITION" / <composition>
   */

   TEST CAR(ITEM)=NUMOFSTR("ALTERNATIVES") THEN ITEM:=CDR(ITEM)
	OR ITEM:=CDR(CDR(ITEM))
   
   UNTIL ITEM=@NULL DO $(
     static $( NAME = NIL; SCORE = NIL; BIT = NIL $)
     
     NAME:=CAR(ITEM);
     ITEM:=CDR(ITEM)
     SCORE:=CAR(ITEM);
     ITEM:=CDR(ITEM)
     BIT:=CONS(NAME,SCORE)
     ALTS:=CONS(BIT,ALTS)
     $)
   $)

 FINDSEGP(CHUNKSEP,TTHEADSTR);
 LINEIN("");
 TERMTYPE:=LOPITEM();
 FINDSEGP(CHUNKSEP,ESHEADSTR);
 SKIPSEG(ESSEP);
 ALLDEFS:=@NULL;
 $(
 LINEIN("");
 IF LITEMS!0=1 DO BREAK;
 DEFNAME:=LITEMS!2;
 LINEIN("");
 ALLDEFS:=CONS(CONS(DEFNAME,LINELIST(LOPITEM)),ALLDEFS);
 SKIPSEG(ESSEP);
 $) REPEAT;
 CLOSEIN();
 MODMF:=@NULL;
 CONLENGTHS:=@NULL
 $);



LET REVISESCORE(STR,VAL) = VALOF $(RVSC

 /* In MSI functions, and possibly elsewhere, will allow scores
 associated with alternatives to be revised. Revision based on MYCIN
 type combination formula (assymptopically converging to CFMAX), belief
 disbelief measures etc.
 */
 static $( BELIEF = NIL; DISBELIEF = NIL; ITEM = NIL; OLDSCORE = NIL; SCORE = NIL $)

 if STR=NUMOFSTR("None-of-these") then return

 ITEM:=ASSOC(STR,ALTS)
 if ITEM =@NULL resultis VAL

 BELIEF,DISBELIEF,SCORE:=0,0,0


 TEST VAL LS 0 THEN DISBELIEF:=-VAL OR BELIEF:=VAL

 OLDSCORE:=CDR(ITEM)

 OLDSCORE:=OLDSCORE-CFMAX


 TEST OLDSCORE LS 0 THEN DISBELIEF:=DISBELIEF-((CFMAX-DISBELIEF)*OLDSCORE)/CFMAX
 OR BELIEF:=BELIEF+((CFMAX-BELIEF)*OLDSCORE)/CFMAX

 SCORE:=BELIEF-DISBELIEF

 unless SCORE=VAL do $(
	OUTS("(Effective score for "); OUTSNUM(STR);
	OUTS(" now "); OUTNO(SCORE)
        OUTS(")*C*L")
	$)

 resultis SCORE

$)RVSC

